perm filename SCOLB.F4[MUS,LCS]3 blob
sn#085781 filedate 1974-02-05 generic text, type T, neo UTF8
C THIS PROGRAM IS THE PROPERTY OF LELAND SMITH, PROFESSOR OF MUSIC
C AT STANFORD UNIVERSITY. IT MAY NOT BE COPIED OR ALTERED IN ANY
C WAY WITHOUT WRITTEN PERMISSION OF THE AUTHOR.
C 6/10/72 ********** SCORE ********** LELAND SMITH, SEP.1969
C THIS PROGRAM WRITES NOTE LISTS FOR THE PDP10 SOUND
C GENERATION PROGRAM.
C IF # OF INSTS IS CHANGED, ALSO CHANGE # IN 'INFO' FORMAT.
C LOAD 'SCORE' WITH BRZ.REL (RAN. NUM GENERATOR),SPRINT.MAC AND,
C SCANX, (AND QUAD AND QUADO WHEN THEY ARE READY) AND
C IF DESIRED, A SUBROUTINE WITH THE FOLLOWING HEADING:
C SUBROUTINE SUBR
C COMMON /INS/ INST(27),BG(60)
C COMMON P(30),INUM,IPAR,CNT(27),BT,PL(48),IREST,DF
C INUM=INST# IPAR=PARAM#
C BT=BASIC TIME P1 WHEN SUBROUTINE IS CALLED
C IF IREST IS <0, THAT NOTE WILL BE A REST.
C INST=INST. NAME, BG=INSTS' BEGIN TIMES.
C NOTE #S IN SUBROUTINE: (1-84) C4=37 FS4=43 C5=49 ETC.
C F1=86 F15=100 (NO F16!)
COMMON /Q/ BNW(100),NWZ
COMMON /INS/INST,BG
DIMENSION ROFF(27),V(2000),NP(27),PCH(27,32),INST(27)
1 ,RDEV(27),IPT(27,31),XT(27),BG(60),OTH(20,16),SCAL(101)
1 ,IV(2000),NCNT(27,32),P1(27),IT(30),JFM(4)
1 ,IOUT(70),IFM(80),COPY(30),LIST(78),JPT(837)
1 ,FINM(6),TINST(5),TPALN(4),ENFI(5),TEDIT(4),INVIS(27)
C WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY
C 40 LIT CHARS + 30 PARAMS PER INST.
C 60 BG TIMES AVAILABLE. FOR INSTS AND INSERTS AND EDITS.
COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
1 ,IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
1 ,INP(72),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
EQUIVALENCE (PP1,P(1)),(P(2),P2),(P(3),P3),(P(4),P4),
1 (VX1,VX(1)),(INP1,INP(1)),(PL4,PL(4)),(IPP,ISCA(2))
1 ,(IEN,ISCA(4)),(IPT,JPT),(ISS,ISCA(9)),(ITT,ISCA(11))
1 ,(IE,ISCA(5)),(ID,ISCA(3)),(IF,ISCA(6)),(IAA,ISCA(10))
1 ,(VX2,VX(2)),(VX3,VX(3)),(NCNT,PCH),(VX4,VX(4))
1 ,(VX5,VX(5)),(IDOT,IDAT(11)),(VX,IOUT),(IFM3,IFM(3))
1 ,(IT,INP(27)),(V,IV),(PLAY,ISCA(7)),(IFM2,IFM(2))
1 ,(IFM4,IFM(4)),(IFM(3),LIST)
DATA KZY/27/,ISEMI/';'/,RTF/.05/,IQT/'"'/
1, JFM(3)/','/
C IAA=A ID=D IE=E IF=F IEN=N IPP=P ISS=S ITT=T
DATA KSLA/'/'/,IBLA/' '/,BLA/' '/,IXX/'X'/,ITMPO/'TEMPO'/
1 ,ISCA/'C','P','D','N','E','F','PLAY;','G','S','A','T','B'/
1 ,IDAT/'0','1','2','3','4','5','6','7','8','9','.'/
1 ,SCAL/'C/8','CS/8','D/8','DS/8','E/8','F/8','FS/8','G/8',
1 'GS/8','A/8','AS/8','B/8','C/4','CS/4','D/4','DS/4','E/4',
1 'F/4','FS/4','G/4','GS/4','A/4','AS/4','B/4','C/2','CS/2',
1 'D/2','DS/2','E/2','F/2','FS/2','G/2','GS/2','A/2','AS/2',
1 'B/2','C','CS','D','DS','E','F','FS','G','GS','A','AS',
1 'B','C*2','CS*2','D*2','DS*2','E*2','F*2','FS*2','G*2',
1 'GS*2','A*2','AS*2','B*2','C*4','CS*4','D*4','DS*4','E*4',
1 'F*4','FS*4','G*4','GS*4','A*4','AS*4','B*4','C*8','CS*8',
1 'D*8','DS*8','E*8','F*8','FS*8','G*8','GS*8','A*8','AS*8',
1 'B*8','R','F1','F2','F3','F4','F5','F6','F7','F8','F9',
1 'F10','F11','F12','F13','F14','F15','END'/,I1X/'1X'/
1 ,IFM(1)/'('/,IFM2/'1XA5,'/,IFCOM/5H', ',/,IA1/'A1,'/
LPAR=0
IPRN=0
QX=0.
MOT=0
RETRO=-1.
INVRT=-1
LCNT=1
PARENS=0
JZ=1
CALL RNDINT
PR=0
IAMP=0
C IAMP IS 'BLANK LINE'FLAG ON PP1-3.
T5=0
NINS=0
K=0
IDALL=-1
QTS=-1.
KB=0
NWZ=1
BNW(1)=0
I=1
KL=0
TP=0
KN=IBLA
RA=0
CHN=0
DO 127 K=1,77,3
127 LIST(K)=0
C INITIALIZES MOTIVIC LIST FOR ERROR FINDING ROUTINE.
NWX=0
BY=-1
DO 1128 K=1,KZY
INVIS(K)=0
INST(K)=0
CNT(K)=0
RDEV(K)=0
C RDEV IS FOR RAND DEVIATIONS AT RUN TIME
NP(K)=0
IQ(K)=0
C IQ IS FOR RESTART FLAG
IPT(K,1)=0
DO 1128 L=1,32
1128 PCH(K,L)=0
ITYP=-1
C TYPE 'FILE NAME', TEMPO FACTOR(0=1), AMPL.FACT(0=1),
C SECONDS TO BE OMITTED, DUR AT CUTOFF.
JED=-1
2112 TYPE 8002
1112 ACCEPT 77732,INP
JFM(4)='5F)'
JFM(1)=' (A'
C FOR FREE 'A' FORMAT
CALL FMT(JFM,INP,MLX)
REREAD JFM,K,TF,AMPFAC,OP1,DURX
C JFM IS THE CURRENT FORMAT STATEMENT
IF(K.NE.'EDIT')GO TO 3112
JED=0
GO TO 2112
C 'E(DIT)' GOES TO EDIT MODE
3112 IF(TF.EQ.0)TF=1.
IF(AMPFAC.EQ.0)AMPFAC=1.
CC**FROM 11700 CHANGED 3/73 IF(TF.NE.999.)GO TO 21122
21122 IF(K.NE.'TYPE')GO TO 128
ITYP=0
DATA FINM/30H(' TYPE OUTPUT FILE NAME'/) /
TYPE FINM
C TO USE TYPE-IN MODE. FILE OF INPUT IS WRITTEN ON FOR21.DAT
ACCEPT 1127,ISLAC
IF(ISLAC.EQ.IBLA)STOP
REWIND 21
CC WRITE (21,11122) ISLAC
WRITE (21,1127) ISLAC
GO TO 3127
11122 FORMAT(1XA5,72A1)
128 IF(K.NE.'INFO')GO TO 3128
TYPE 8002
TYPE 1113
TYPE 118
TYPE 1114
TYPE 8002
GO TO 1112
118 FORMAT(' TO DSK=1, TTY=2, BOTH=0, LPT=22, PROOF=3, DEBUG=4'/)
8002 FORMAT(' TYPE FILE NAME'/)
8001 FORMAT(A5,5F)
107 FORMAT(I,A5,5F)
1113 FORMAT(' NAME, TF, AMPFAC, OMIT", DUR".'/)
1114 FORMAT(' N1, N2=RAN NUM, N3=0 LISTS INPUT, N4=SINGLE INST.'/
1 ' IF -- N1=3 DURS ONLY, =4 V ARRAY'/
1 3X' 27 INSTRUMENTS ARE AVAILABLE'/)
1127 FORMAT(A5,72A1)
3128 IF(K.NE.IBLA)IFLNM=K
CALL IFILE(1,IFLNM)
READ(1,107)LN,ISLAC
REREAD 77732,INP
C FOR LATER USE
IF(LN.NE.0)GO TO 3127
C JUMP IF THE FILE HAS LINE NUMBERS.
REREAD 1127,ISLAC
C REREADS FIRST LINE
CC IF(ISLAC.NE.'COMME')GO TO 3127
CC DO 31271 K=1,72
CC READ(1,77732),KL,KL
CC31271 IF(KL.EQ.ISEMI)GO TO 3127
C TO SKIP OVER 'COMMENT' SECTION OF TVED FILES.
3127 TYPE 118
IF(DURX.EQ.0)DURX=19999.
IXIN=1
DO 1107 K=1,30
1107 PL(K)=1.
INONLY=-1
ACCEPT 300,MX,X,Y,Z
IF(Z.NE.0)INONLY=Z
IF(X.NE.0)IXIN=X
C MX=3 GIVES DURS ONLY
C TO SUPPRESS LIST OF INPUT DATA, TYPE ANY 3RD NUM. (BUT 9.)
C (1 1 1 =RECORD,RAN. NUM=1,SUPPRESS INPUT.)
MZ=0
JOUT=5
C 5=OUTPUT TO TTY
SOS=-1.
IF(Y.NE.0)SOS=0
C IF 3RD NUM≠0, EDIT FILE WILL PRINT AS IT IS READ.
IF(MX.NE.22)GO TO 2107
JOUT=22
REWIND 22
2107 IF(MX.LE.1)MX=MX-2
IF(MX.EQ.-2.OR.MX.EQ.2.OR.MX.EQ.22)MZ=-1
IF(MX.EQ.4)MZ=-4
IF(SOS.AND.ITYP)WRITE(JOUT,87732)INP
CC IF(ITYP.EQ.0)GO TO 2308
CC WRITE(JOUT,77732)INP
C *************** READS INPUT ***********************
2308 IF(ITYP)GO TO 2127
DATA TINST /25H(' TYPE INST NAME, ETC'/)/
1,TEDIT/20H(' RETYPE LINE?'/ )/
23081 TYPE TINST
ACCEPT 77732,INP
IF(JED)WRITE(21,77732)INP
JFM(4)='72A1)'
C PUTS ON LPT AND TTY
CC JFM(1)=' (A'
CC CALL FMT(JFM,INP,MLX)
CC REREAD JFM,J,INP
CC WRITE(21,11122) J,INP
GO TO 1074
2127 JREAD=1
4400 READ(1,77732,END=2337)INP
IF(SOS)WRITE(JOUT,87732)INP
GO TO(441,442,443,444,445,446)JREAD
441 JFM(4)='72A1)'
IF(LN.EQ.0)GO TO 1074
REREAD 2114,LN,INP
JFM(1)=' (I,A'
CALL FMT(JFM,INP,MLX)
REREAD JFM,LN,J,INP
GO TO 4127
1074 JFM(1)=' (A'
CALL FMT(JFM,INP,MLX)
REREAD JFM,J,INP
CC IF(LN.EQ.0)READ(1,1127,END=2337)J,INP
4127 IF(JED.OR.K.EQ.'Y')GO TO 41271
C K CHECK IS TO PASS AFTER RETYPING
TYPE TEDIT
ACCEPT 77732,K
IF(K.EQ.'Y')GO TO 23081
IF(K.EQ.'G')JED=-1
41271 IF(J.EQ.IBLA)GO TO 2308
MLX=1
IZ=0
JA=-1
ISUB=4
ALL=1.
VX1=0
VX2=0
VX3=0
LK=-1
K=0
IF(V(I-1).NE.-9900.-BY)GO TO 364
BY=-1.
I=I-1
364 DO 361 JD=1,72
N=INP(JD)
IF(N.NE.'R')GO TO 361
C LOOKS FOR 'RESTART'
DO 3611 M=JD,72
KL=INP(M)
IF(KL.EQ.IBLA.OR.KL.EQ.ISEMI.OR.KL.EQ.KSLA.OR.KL.EQ.',')GO TO 3631
CC IF(INP(M).EQ.IBLA)GO TO 3631
3611 INP(M)=IBLA
C CHANGES 'RESTART' TO BLANKS
3631 DO 363 N=1,NINS
IF(J.NE.INST(N))GO TO 363
IQ(N)=-1
C SETS RESTART FLAG. THIS INST WILL NOW APPEAR WITH NEW NUM.
GO TO 362
363 CONTINUE
361 IF(N.EQ.KSLA.OR.N.EQ.ISEMI)GO TO 6773
6773 K=K+1
IF(K.GT.NINS)GO TO 36
IF(INST(K).NE.J.OR.IQ(K).EQ.-1)GO TO 6773
C FINDS CORRECT INST NUM. PASSES RESTARTED INSTS.
LK=K
GO TO 1773
36 IF(J.EQ.'RUN;'.OR.J.EQ.'RUN')GO TO 2337
IF(J.EQ.'INSER'.OR.J.EQ.'EDIT')ISUB=6
IF(J.EQ.ITMPO.OR.J.EQ.'CONDU'.OR.J.EQ.'PLAY'.OR.ISUB.GT.4)
1GO TO 1773
IF(J.EQ.'SECTI')GO TO 1081
C****************** ABOVE AND BELOW FOR 'SECTIONS'
IF(J.EQ.'END'.OR.J.EQ.'END S'.OR.J.EQ.'FINIS')GO TO 1082
362 LK=NINS+1
IF(LK.GT.KZY)GO TO 99
INST(LK)=J
IZ=LK
GO TO 1773
C*********** DOWN TO 99 FOR 'SECTIONS'
1083 V(I)=-99.
KL=1
GO TO 3083
C READS 'PLAY SECT. N1,N2'
1081 V(I)=-199.
KL=4
3083 DO 2081 K=KL,72
IF(INP(K).EQ.IBLA)GO TO 2081
IV(I+1)=INP(K)
I=I+2
3081 BY=-1.
GO TO 2308
2081 CONTINUE
C READS SECTION IDENTIFIER, -199. MARKS BEGINNING
C1082 IF(V(I-1).EQ.-9900.-BY)I=I-1
C********* FEB 15,71
1082 V(I)=-299.
I=I+1
GO TO 3081
C MARKS END OF SECTION
C************************
99 TYPE 199,LN
STOP
199 FORMAT(' ERROR!! LAST LINE READ =',I6/)
4 IF(LK.LE.NINS)GO TO 8773
IF(ALL.GT.0)GO TO 1004
IF(IDALL.GT.0)GO TO 8773
BG(LK)=VX1
IDALL=LK
GO TO 2004
C 'MOVE' CHANGES IN 'ALINS' CAN'T BE RESET IN INDIV. INSTS.
1004 BG(LK)=VX1
IF(LK.EQ.IZ)VX1=0
C MAY 3,71 **** ALL PARAMS WILL BE SET UP AT TIME 0.
C CHECK EFFECT ON 'MOVE'!
C ******** APR.23, 1971 FIXES BG TIMES IN 'MOVE'?????!!!!!!!
2004 NINS=LK
IF(VX3.NE.0)VX2=10000.+VX3
IF(VX2.EQ.0)VX2=-1
DUR(LK)=VX2
GO TO 900
C******** ABOVE FOR REST ONLY ENTRIES. FEB 18,71
8773 IF(VX2.NE.0)VX1=VX1*10000.+VX2
900 IF(VX1.EQ.BY.AND.J.NE.'PLAY')GO TO 5773
C*********** 'PLAY' IS FOR 'SECTIONS'
BY=VX1
C BY=CURRENT BG TIME.
C********* FEB 15,71
V(I)=-9900.-BY
I=I+1
IF(NWZ.NE.0)CALL BGSORT(BY)
5773 IF(J.EQ.'TEMPO')GO TO 1106
IF(J.EQ.'CONDU')GO TO 3018
IF(J.EQ.'PLAY')GO TO 1083
C*********** ABOVE FOR 'SECTIONS'
4773 NW=LPAR
IF(I.GT.1900.)TYPE 107,I
ALL=1.
DF=0
ISUB=1
1299 IF(JZ.NE.0)GO TO 1773
7773 IF(ITYP)GO TO 77731
DATA TPALN /20H(' TYPE A LINE'/) /
77734 TYPE TPALN
ACCEPT 77732,INP
IF(JED)WRITE(21,77732) INP
IF(INP1.EQ.IBLA)GO TO 77734
GO TO 77733
77732 FORMAT(72A1)
87732 FORMAT(1X72A1)
77731 JREAD=2
GO TO 4400
442 IF(LN.NE.0)REREAD 2114,LN,INP
IF(INP1.EQ.IBLA)GO TO 77731
IF(JED)GO TO 77733
TYPE TEDIT
ACCEPT 77732,K
IF(K.EQ.'Y')GO TO 77734
IF(K.EQ.'G')JED=-1
C DOESN'T WORK FOR EDITS AND INSERTS YET???
CC IF(SOS)WRITE(JOUT,2114),LN,INP
77733 MLX=1
C 'LISTS' MUST END WITH *
CC1773 JZ=0
1773 IF(IPRN.EQ.0)GO TO 17732
L=I-1
IF(QTS.AND.V(I-1).EQ.999.)L=L-1
IPRN=IPRN-1
IF(PARENS.EQ.0)GO TO 17733
PARENS=0
LIST(LCNT+2)=L
LCNT=LCNT+3
IF(IPRN.EQ.0)GO TO 17732
IPRN=0
17733 LIST(MOT)=L
MOT=0
C FOR ERROR TRAP
17732 JZ=0
N=0
17731 ML=MLX
C BIG LOOP -- TO END OF PAGE 1.
JD=ML
975 N=INP(JD)
IF(N.EQ.IBLA.OR.N.EQ.',')GO TO 236
C ((((())))) MAY 13,71 /Z (D4/E/X 2 3)/ CS/ ETC. CAN USE 26 LABELS.
33611 IF(N.NE.'('.AND.N.NE.')')GO TO 2361
INP(JD)=IBLA
L=JD-1
5113 IF(INP(L).NE.IBLA)GO TO 2113
L=L-1
GO TO 5113
2113 IF(N.EQ.')')GO TO 3361
IF(PARENS.EQ.0)GO TO 1140
LCNT=LCNT+3
IF(MOT.NE.0)GO TO 11403
MOT=LCNT-1
1140 DO 11401 JC=1,LCNT-1,3
IF(INP(L).NE.LIST(JC))GO TO 11401
C FINDS DUPLICATE IDENTIFIER
TYPE 11402,INP(L)
GO TO 99
11403 TYPE 11404
GO TO 99
11404 FORMAT(' MORE THAN 2 PARENS OPEN'/)
11402 FORMAT(' MOTIVIC (',A1,') USED TWICE')
11401 CONTINUE
LIST(LCNT)=INP(L)
PARENS=-1.
INP(L)=IBLA
LIST(LCNT+1)=I
GO TO 236
CC33612 IF(QTS)GO TO 236
CC GO TO 6721
C ''''''' FOR SINGLE QUOTES
3361 IPRN=IPRN+1
CC IF(QTS)GO TO 236
CC GO TO 7231
GO TO 236
C JUMPS BACK INTO QUOTE SECTION
CQ IF(PARENS.EQ.0)GO TO 2140
CQ LIST(LCNT+2)=L
CQ LCNT=LCNT+3
CQ PARENS=0
CQ GO TO 33612
CQ2140 LIST(MOT)=L
CQ GO TO 33612
CQC ))))))))))) LAST ) CAN'T APPEAR AT END OF LINE!!
C @@@@@@@@@@@@ /@Z/DS3/ ETC.
2361 IF(N.NE.'@')GO TO 5361
DO 113 L=1,72
K=JD+L
C K IS USED AT 240!!!
JG=INP(K)
IF(JG.NE.'-')GO TO 6113
RETRO=0
INP(K)=IBLA
GO TO 113
6113 IF(JG.NE.'$')GO TO 7113
C '$' IS FOR INVERSIONS IN 'NOTES'
INVRT=0
GO TO 113
7113 IF(JG.NE.IBLA)GO TO 4113
113 CONTINUE
4113 DO 6361 L=1,LCNT,3
IF(JG.NE.LIST(L))GO TO 6361
VX1=0
DO 40 M=JD+2,72
JG=INP(M)
IF(JG.EQ.IBLA)GO TO 40
IF(JG.EQ.KSLA.OR.JG.EQ.ISEMI.OR.JG.EQ.'*')GO TO 140
ML=M
GO TO 240
40 CONTINUE
240 JC=JA
JA=-1
INP(K)=IBLA
CALL SCANR
JA=JC
140 JC=1
KN=LIST(L+1)
M=LIST(L+2)+1
IF(RETRO)GO TO 640
JC=M-1
M=KN-1
KN=JC
JC=-1
RETRO=-1.
640 IF(INVRT)GO TO 940
840 X=V(KN)
V(I)=X+VX1
C FINDS CENTER FOR INVERSION (+TRANSP.)
I=I+1
KN=KN+JC
IF(V(KN-JC).NE.85.)GO TO 940
V(I-1)=85.
GO TO 840
940 Z=V(KN)
IF(INVRT.EQ.0)GO TO 440
IF(VX1.EQ.0)GO TO 540
C " @Q N " WHERE N= 1/2 STEPS IN 'NOTES' OR MULT FACTOR IN OTHERS.
IF(CODE.EQ.-33.)GO TO 440
V(I)=Z*VX1
GO TO 7361
440 IF(Z.EQ.85.)GO TO 540
Y=0
IF(INVRT.EQ.0)Y=(X-Z)*2.
V(I)=Z+VX1+Y
GO TO 7361
540 V(I)=Z
7361 I=I+1
KN=KN+JC
IF(KN.NE.M)GO TO 940
INVRT=-1
RB=V(I-1)
CC ICT=-1
DO 8361 L=JD,72
JG=INP(L)
CC IF(JG.EQ.ISEMI)GO TO 93611
C PUT IN NOV 25, 72
IF(JG.EQ.ISEMI)GO TO 93612
INP(L)=IBLA
IF(JG.EQ.KSLA)GO TO 9361
IF(JG.EQ.')')IPRN=IPRN+1
CC8361 IF(JG.EQ.'*')ICT=0
8361 IF(JG.EQ.'*')IAMP=-1
9361 MLX=L
C FIX THIS & =IBLA BY CHNGING DO LOOP TO 'GO TO' AT 6721,2722
CC IF(ICT.AND.QTS)GO TO 17731
CC↓↓↓↓↓↓↓↓↓↓↓ CHNGD JUNE 24,73 IF(IAMP.EQ.0.AND.QTS)GO TO 17731
IF(IAMP.EQ.0.AND.QTS)GO TO 1773
JZ=-1
CC IF(QTS)GO TO 3013
93612 IF(IAMP.EQ.0)GO TO 93611
CC93612 IF(ICT.EQ.0)IAMP=-1
C NOV 25, 72
IF(QTS)GO TO 3013
GO TO 2722
CC93611 IF(ICT.EQ.0.AND.QTS.EQ.0)GO TO 2722
CC93611 IF(IAMP.AND.QTS.EQ.0)GO TO 2722
C THESE ARE FOR "LIT" ITEMS
C ******* DO NOT USE '@-' OR '@$' WITH 'LIT' ****** ! ! ! !
CC IF(QTS)GO TO 7773
93611 IF(JG.EQ.ISEMI)GO TO 7773
JZ=0
IF(IPRN.NE.0)GO TO 1773
C ↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑PICKS UP ' @X)/ ' SITUATION. 22/6/73
GO TO 236
C LAST TIME FOR QUOTES
CC93611 IF(ICT.AND.QTS)GO TO 7773
C********↑↑ ↑↑ WAS TO 6017 JUNE 10,71
CC IF(QTS)GO TO 3013
CC IF(ICT)GO TO 6721
C JUMPS TO END STRING OF QUOTES
6361 CONTINUE
GO TO 99
C @@@@@@@@@@@@@@@@@@@@@@@@@@
5361 IF(N.NE.ID.OR.ISUB.NE.1)GO TO 53611
IF(INP(JD+1).NE.IF)GO TO 236
C JUMP IF NOT DUTY FACTOR
DF=DF-100.
CC GO TO 53611
GO TO 43615
53611 IF(N.NE.ISS.OR.INP(JD+1).NE.'U')GO TO 53612
DF=DF-200
C FOR SUBROUTINE FLAG. CAN'T CALL SUBR AT SAME TIME AS REP OR X!!!!
GO TO 43615
53612 IF(N.NE.IAA)GO TO 43611
C FINDS 'ALL'.
IF(INP(JD+1).NE.'L')GO TO 236
ALL=-1.
CC INP(JD+2)=IBLA
CC53611 INP(JD)=IBLA
CC INP(JD+1)=IBLA
CC GO TO 236
GO TO 43615
C TYPE 'ALL' AFTER PARAM NUM TO PUT DATA IN ALL INSTS.
C QUAD CALL MUST BE IN 1ST OF 5 PARAMS. QUAD MUST BE FOLLOWED
C BY SPC, / OR ;. OTHER CALLS SUCH AS MOVE,NUM ETC. CAN
C APPEAR BEFORE / OR ;, BUT "ALL" MUST! APPEAR
C BEFORE! QUAD (IF USED).
C ADD AN "F" TO QUAD FOR FUNCTIONS, AN "X" FOR X,Y COORDS.
C BASIC QUAD PRODUCES CIRCLES. /DEGS/RADIUS/CENT. X/CENT. Y/
C QUADX -- /X /Y / (5TH PARAM WILL ALWAYS BE WASTED)
43611 IF(N.NE.'Q'.OR.INP(JD+1).NE.'U')GO TO 4361
QX=-13.
DO 43612 N=JD,72
J=INP(N)
IF(J.EQ.IXX)QX=QX-1.
IF(J.EQ.IF)QX=QX-2.
IF(J.EQ.IBLA.OR.J.EQ.KSLA.OR.J.EQ.ISEMI.OR.J.EQ.',')GO TO 236
43612 INP(N)=IBLA
4361 IF(N.NE.'I')GO TO 43613
IF(ISUB.NE.4)GO TO 43613
C NEXT MAKES INST NAME, P1 AND P2 INVISIBLE (REPLACES SEG, ETC.)
INVIS(LK)=-1
43615 DO 43614 L=JD,72
N=INP(L)
IF(N.EQ.IBLA.OR.N.EQ.','.OR.N.EQ.ISEMI.OR.N.EQ.KSLA)GO TO 236
43614 INP(L)=IBLA
43613 IF(N.NE.KSLA)GO TO 636
MLX=JD+1
JZ=-1
INP(JD)=ISEMI
436 IF(INP(MLX).NE.IBLA)GO TO 336
MLX=MLX+1
GO TO 436
636 IF(N.NE.ISEMI)GO TO 936
336 IF(ISUB.EQ.104)GO TO 104
IF(ISUB.GT.3)GO TO 1899
GO TO (101,102,103),ISUB
C PAR MOV LIST OTHERS
936 IF(N.NE.IDOT)GO TO 736
L=INP(JD+1)
DO 836 KL=1,10
836 IF(L.EQ.IDAT(KL))GO TO 236
IF(CODE.EQ.-22.)INP(JD)=1
GO TO 236
C CHANGES DOTTED RHYTHMS TO '1'S.
736 IF(N.NE.'*')GO TO 136
IAMP=-1
INP(JD)=IBLA
C ******* WAS ISEMI ****** WHY?
136 IF(N.NE.IQT)GO TO 236
DO 1361 K=JD+1,72
IF(INP(K).NE.IQT)GO TO 1361
JD=K+1
GO TO 975
C SKIPS MATE∧aP⊂⊂IN QUOTES
1361 CONTINUE
GO TO 99
C OPEN QUOTES
236 JD=JD+1
IF(JD.LT.73)GO TO 975
TYPE 1236
GO TO 99
1236 FORMAT(' MISSING SEMICOLON')
101 N=INP(ML)
IZ=ML
ML=ML+1
IF(N.EQ.IBLA)GO TO 101
C ⊗⊗⊗⊗⊗ MAY 13,71 @@@@@@@@@@
JA=-1
IF(N.EQ.IPP)GO TO 1
IF(N.EQ.IE)GO TO 2308
IF(N.EQ.'R')GO TO 2337
C 'RUN' MAY REPLACE 'END' FOR LAST INST.
IF(N.EQ.ID)GO TO 7720
GO TO 99
1 CALL SCANR
LPAR=VX1
IJ=LPAR
IF(QX.GE.0)GO TO 5703
IJ=LPAR+4
C SETS UP PARAM FOR QUAD CALL
V(I)=IJ+LK*10000
V(I+1)=2*ALL
C TEST "ALL" FEATURE HERE!!!!!!!
C X=-13(DEGREES),=-14(X,Y),=-15(CIRCLE FUNCTS),=-16(LINE FUNCTS)
V(I+2)=QX
I=I+3
QX=0.
5703 IAMP=0
IF(IJ.GT.NP(LK).AND.IJ.LT.31)NP(LK)=IJ
IF(LPAR.EQ.32)LPAR=1
V(I)=LPAR+LK*10000
C +1=WDCNT, +2=CODE, +3='NM' CCCCC
IJ=I+1
I=I+4
ITMP=0
CODE=0
NFLG=1
ML=IZ+M
C RE=REP R=RHY L=LIT M=MOVE MX=MOVX N=NOTES NU=NUM
C S--L=SUBL S--N=SUBN T=TAP RT=RTAP RL=RLIST RN=RNOTES
C QU=QUADC QUX=QUADX QUF=QUADCF QUFX=QUADFX
5702 ML=ML+1
IF(ML.GT.72)GO TO 99
N=INP(ML)
IF(N.EQ.IBLA.OR.N.EQ.',')GO TO 5702
NL=INP(ML+1)
JA=-1
ISUB=0
IF(N.EQ.IXX)GO TO 2703
IF(N.EQ.'R')GO TO 6702
IF(N.EQ.IF)GO TO 8702
CC IF(N.EQ.ID)GO TO 1703
4005 JA=0
IF(N.EQ.IEN)GO TO 6005
IF(N.EQ.'M')GO TO 703
IF(N.EQ.'L')GO TO 2720
IF(N.EQ.ISS)GO TO 6703
IF(N.EQ.ITT)GO TO 4018
IF(N.EQ.IQT)GO TO 5720
IF(N.EQ.ISEMI)GO TO 2018
IF(N.EQ.IPP)JA=-1
C FOR /P5 P3/
CALL SCANR
IF(ISUB.EQ.8)GO TO 8
I=I+JJ
V(IJ+1)=NNUM+DF
IF(JJ.EQ.1)GO TO 4006
C IF NNUM IS '-2' THEN NOTES ARE PRINTED
IF(NNUM.NE.-2)GO TO 5006
IX=IJ+3
DO 2006 K=2,JJ,3
CC X=VX(K)
CC Y=VX(K+1)
CC IF(X.GT.Y)VX(K)=X+.999
CC2006 IF(Y.GT.X)VX(K+1)=Y+.999
2006 CALL RANR(VX,K)
C FOR RAN. SELEC. OF NOTES. FINDS HIGHEST NOTE.
5006 IX=IJ+2
DO 6006 K=1,JJ
6006 V(IX+K)=VX(K)
GO TO 3013
4006 IF(JA)VX1=VX1/100.+9999.
C CHANGES /P5 P3/ TO /P5 9999.03/
V(I-1)=VX1
GO TO 3013
6702 IF(NL.EQ.IE)GO TO 2703
C JUMP IF "REP"
IF(NL.EQ.ITT)GO TO 4018
C JUMP IF "RTAP"
CODE=-22
IF(NL.EQ.'L')CODE=-46.0
C JUMP IF "RLIST" (LIST OF RAND SELECTIONS)
IF(NL.NE.IEN)GO TO 1016
C JUMP IF NOT "RNOTES"
JA=0
C FOR SCANR
CODE=-36.
GO TO 1016
6005 CODE=-33
IF(NL.NE.'U')GO TO 1016
CODE=-44.
1610 JA=-1
GO TO 1016
8702 CODE=-35
IF(NL.EQ.'U')GO TO 1016
ML=ML+1
CALL SCANR
7 V(IJ+1)=CODE+DF
V(IJ+2)=1.
V(I)=VX1+85.
GO TO 7703
703 BW=V(IJ-2)
IC=0
DO 7031 K=ML+1,72
IF(INP(K).EQ.ISEMI)GO TO 8031
7031 IF(INP(K).EQ.IXX)IC=-1
C**************** JUNE 1,71 X 4
8031 I=I-1
V(I)=0
C ********* FEB. 15,71
X=-9900.-BY
IF(BY.EQ.0)X=-9900.-BG(LK)
IF(BW.EQ.X)GO TO 8005
IF(BW.NE.-9900.-BY)GO TO 1102
V(IJ-2)=X
GO TO 8005
1102 V(IJ)=V(IJ-1)
V(IJ-1)=X
IJ=IJ+1
I=I+1
8005 LP=IJ-1
BW=-9900.-X
ISUB=2
IZ=-1
C ABOVE ARRANGES NECESSARY BG TIME HEADINGS.
4703 GO TO 1299
102 IF(IZ.LT.0)GO TO 2102
BW=V(ICT)+BW
V(I)=-9900.-BW
V(I+1)=V(LP)
V(I+2)=(JJ+2)*ALL
V(I+3)=CODE+DF
I=I+4
IZ=1
2102 IF(BW.LT.10000.)CALL BGSORT(BW)
C ROUND-OFF NONSENSE
2 VX3=-9900.
VX2=VX3
CALL SCANR
IF(JJ.EQ.4)GO TO 99
IF(VX3.NE.-9900.)GO TO 3102
IF(VX2.NE.-9900.)GO TO 4102
VX2=VX1
VX1=10000.
4102 VX3=VX2
JJ=3
C 1,2 OR 3 NUMS CAN BE USED IN NON-RAN MOVES.
3102 IF(IZ.GE.0)GO TO 3006
V(IJ)=(JJ+2)*ALL
C WORD COUNT
CODE=-55.
IF(JJ.NE.3)CODE=-57.
C THIS IS NOW OUT, FEB 15,70. -10000. MEANS 'NOTES AT BG TIME 0'
IF(NFLG)CODE=CODE-1.
IF(IC)CODE=-59.
C**************** JUNE 1,71
C CODE=-56 OR -58 FOR NOTES.
V(IJ+1)=CODE+DF
IZ=0
3006 IF(NFLG.EQ.1)GO TO 5005
CC IF(VX2.GT.VX3)VX2=VX2+.999
CC IF(VX3.GE.VX2)VX3=VX3+.999
CC IF(JJ.EQ.3)GO TO 5005
CC IF(VX4.GT.VX5)VX4=VX4+.999
CC IF(VX5.GE.VX4)VX5=VX5+.999
CALL RANR(VX,2)
IF(JJ.NE.3)CALL RANR(VX,4)
C FOR RAN. SELEC. OF NOTES. FINDS HIGHEST NOTE.
5005 ICT=I
IJ=IJ+1
DO 1006 K=1,JJ
1006 V(IJ+K)=VX(K)
I=I+JJ
IJ=I+2
IF(IAMP.EQ.0)GO TO 1299
C*************** MAY 18,71 ***** ALWAYS RESETS TO TIME 0 WHEN MOVE IS USED.
V(I)=-9900.-BY
GO TO 8703
CC1703 IF(NL.NE.IF)GO TO 4005
CC CODE=-45.
CC GO TO 1016
C ABOVE IS**** WAS ***** FOR 'DF' (DUTY FACTOR)
7703 V(IJ)=4.*ALL
8703 I=I+1
GO TO 4773
C FOR SUBROUTINES, -12=NUMS. -11=LETTERS.
6703 CODE=-12.
IF(INP(ML+3).EQ.'L')CODE=-11.
V(IJ)=2.*ALL
V(IJ+1)=CODE+DF
I=I-1
GO TO 4773
4018 CNT(LK)=-9900.-BY
P(LK)=V(I-4)
JREAD=3
GO TO 4400
C JUMPS TO READER
443 IF(LN.NE.0)REREAD 107,K,IPT(LK,1)
IF(LN.EQ.0)REREAD 8001,IPT(LK,1)
C NAME OF RHYTHM FILE. (ONLY ONE PER INST.) READS DATA JUST BEFORE RUN
IF(NL.NE.ITT)GO TO 2338
CODE=-23.
GO TO 1016
2338 I=I-4
GO TO 4773
3018 CNT(KZY)=-9900.
JREAD=4
GO TO 4400
444 IF(LN.NE.0)REREAD 107,K,IPT(KZY,1)
IF(LN.EQ.0)REREAD 8001,IPT(KZY,1)
P(KZY)=980000.
GO TO 2308
C CAN'T USE 'TAP' OR 'RTAP' WITH INST KZY IF USING 'CONDUCT'.
C 'REP'
2703 ML=ML+1
VX1=0
VX2=0
VX3=0
IF(N.EQ.IXX)GO TO 2704
INP(ML)=IBLA
INP(ML+1)=IBLA
C WIPES OUT 'EP' IN 'REP'
2704 CALL SCANR
V(IJ)=3.
V(IJ+1)=-66.0
IF(VX1.EQ.32.)VX1=1.
IF(VX1.EQ.0)VX1=LPAR
IF(VX2.EQ.0)VX2=LK-1
V(IJ+2)=VX1+VX2*10000.
KL=VX2
IF(DUR(LK).LT.0)DUR(LK)=DUR(KL)
IF(VX3.EQ.0)GO TO 4773
L=VX3
ML=LK+1
DO 1018 KL=ML,L
IF(LPAR.GT.NP(KL).AND.LPAR.LT.31)NP(KL)=LPAR
IF(DUR(KL))DUR(KL)=DUR(LK)
C TO SET DUR WHEN DUPLICATING NOTES THAT END WITH 'END;;'
V(I)=V(I-4)+10000.
V(I+1)=3.
V(I+2)=-66.
V(I+3)=V(I-1)
1018 I=I+4
GO TO 4773
2018 IF(DF.EQ.0)GO TO 20181
C NEXT FOR Pn SUBR/ I.E. NOTHING BUT P AND SUB CALL. 7/73
V(IJ+1)=-201.
V(IJ+2)=1.
V(IJ+3)=0
GO TO 7703
20181 V(IJ)=3.
V(IJ+1)=-66.
V(IJ+2)=NW+LK*10000
GO TO 4773
C READS /P5 .3 "ABC" .7 "XYZ"/
8 V(IJ+1)=-77.+DF
C DF HAS SUBR CALL INFO
I=I+1
DO 3722 K=1,JJ,2
V(I)=VX(K)
3722 I=I+1
V(IJ+2)=JJ/2
V(IJ+3)=I
DO 4722 K=2,JJ,2
KN=I
I=I+1
L=VX(K)
DO 6722 KL=L,72
IF(INP(KL).EQ.IQT)GO TO 4722
IV(I)=INP(KL)
6722 I=I+1
4722 V(KN)=I-KN-1
V(IJ)=(I-IJ)*ALL
GO TO 4773
2720 QTS=0
ISUB=104
GO TO 1299
104 DO 6721 K=ML,72
JC=K+1
IF(INP(K).EQ.IQT)GO TO 7721
6721 IF(INP(K).EQ.KSLA.OR.INP(K).EQ.ISEMI)GO TO 7232
C FOR REPEAT OF ITEM BY SLASH
7232 DO 7231 K=I-1,1,-1
IF(ABS(V(K)).GT.72.)GO TO 7231
NL=V(K)
DO 7230 KL=K,K+NL
V(I)=V(KL)
7230 I=I+1
GO TO 27222
7231 CONTINUE
5720 IAMP=-1
JC=ML+1
C FOR SINGLE 'LIT' ITEMS.
7721 DO 1722 KL=JC+1,72
IF(INP(KL).NE.IQT)GO TO 1722
JD=KL-1
ML=KL+1
NL=KL-JC
C EXTENT OF LIT ITEM IS FOUND
GO TO 8721
1722 CONTINUE
C CAN'T USE SLASH FOR REPEAT AFTER @Q
8721 V(I)=NL
DO 9721 K=JC,JD
C PUTS ITEM IN "IV" ARRAY
I=I+1
9721 IV(I)=INP(K)
I=I+1
27222 IF(IAMP.EQ.0)GO TO 1299
2722 V(I)=999.
QTS=-1.
27221 V(IJ+1)=-88.+DF
V(IJ)=(I-IJ+1)*ALL
IJ=IJ+2
V(IJ)=IJ+1
I=I+1
ISUB=1
GO TO 1299
7720 V(I)=LK
V(I+1)=3.
V(I+2)=-67.
ML=ML+4
CALL SCANR
V(I+3)=VX1
I=I+4
L=VX1
IF(NP(LK).LT.NP(L))NP(LK)=NP(L)
IF(DUR(LK).LT.0)DUR(LK)=DUR(L)
GO TO 4773
C TYPE 'DUPL N;' N=INST # TO BE DUPLICATED.
142 FORMAT(I,15A5)
1301 FORMAT(15A5)
2773 FORMAT(I,A5,72A1)
2114 FORMAT(I,72A1)
300 FORMAT(I,3F,A1)
301 FORMAT(3F,A1)
6 KB=KB+1
IF(JED.GT.0)JED=0
IF(J.EQ.'INSER')GO TO 1340
OTH(KB,1)=VX1*100000.+VX2*100.+VX3
GO TO 340
1340 X=VX1
IF(VX2.NE.0)X=1000000.+VX1*100000.+VX2
OTH(KB,1)=X
GO TO 1338
C ABOVE IS TO PUT INSERT AFTER NOTE # OF A PARTICULAR
C INSTRUMENT. FOR COMMENT AT START, SET BG TIME TO 1,1
C - BEGIN LINE WITH <,END WITH ;
C UP TO 75 CHARACTERS MAY BE TYPED.
340 IF(VX3.NE.2)GO TO 1338
IF(ITYP.GE.0)GO TO 449
JREAD=5
GO TO 4400
445 OTH(KB,3)=1.
IF(LN.EQ.0)GO TO 447
REREAD 300,K,OTH(KB,2)
GO TO 1447
447 REREAD 301,OTH(KB,2)
1447 IF(JED)GO TO 2308
3445 TYPE TEDIT
ACCEPT 77732,K
IF(K.EQ.'G')JED=-1
IF(J.EQ.'INSER')GO TO 3446
IF(K.NE.'Y'.OR.JED)GO TO 2308
449 TYPE TPALN
ACCEPT 301,OTH(KB,2)
IF(JED)WRITE(21,301) OTH(KB,2)
GO TO 2308
1338 IF(ITYP.GE.0)GO TO 1449
JREAD=6
GO TO 4400
446 IF(LN.EQ.0)GO TO 448
REREAD 142,K,(OTH(KB,JD),JD=2,16)
GO TO 1446
448 REREAD 1301,(OTH(KB,JD),JD=2,16)
1446 IF(JED)2446,3445,2446
3446 IF(K.NE.'Y'.OR.JED)GO TO 2446
1449 TYPE TPALN
ACCEPT 1301,(OTH(KB,JD),JD=2,16)
IF(JED)WRITE(21,1301)(OTH(KB,JD),JD=2,16)
2446 X=OTH(KB,2)
IF(J.EQ.'INSER'.AND.VX3.NE.0.AND.X.NE.'*')GO TO 6
IF(X.EQ.'*')KB=KB-1
C ALLOWS SEVERAL LINES OF 'INSERT' IF ANY 3RD #.
C LAST LINE HAS '*' IN COLUMN 1.
GO TO 2308
C IF NO PARAM NUM IS GIVEN, ALL PARAMS MUST BE TYPED.
C INSERT MAY INCLUDE 10 CHARS(P3-P30),
C P2, A # ONLY. IF MORE THAN 1 PARAM IS TO BE EDITED AND
C P2 IS ONE OF THEM, FIRST EDIT P2 TO DESIRED VALUE,
C CHANGE P2 TO MINUS = THEN INSERT ENTIRE NOTE TO PLAY
C JUST AFTER ORIGINAL NOTE(WHICH WILL BE A REST).
C BX=INST N. Y=NOTE N. Z=PARAM N.
1899 CALL SCANR
GO TO(1,2,3,4,5,6),ISUB
1106 KTMP=1
TP=60.
IAMP=0
BW=BY
ITMP=-1
ISUB=5
JA=-1
GO TO 2016
3019 V(I)=990000.00
V(I+1)=4.
V(I+2)=VX1
V(I+3)=VX2/TP
V(I+4)=VX3/TP
I=I+5
BY=BW
C SEPT 18, 70
IF(VX1.EQ.0)GO TO 2308
BW=BW+VX1
V(I)=-9900.-BW
I=I+1
CALL BGSORT(BW)
9003 IF(IAMP)GO TO 4003
2016 VX3=0
VX2=0
GO TO 1299
5 IF(VX2.NE.0)GO TO 105
C 'TEMPO/120*;' OR 'TEMPO/1.5 72*;' IS OK.
VX2=VX1
VX1=0
105 IF(VX3.EQ.0)VX3=VX2
IF(VX2.LT.11.)TP=1.
IF(J.EQ.ITMPO)GO TO 3019
PCH(1,KTMP)=VX1
PCH(2,KTMP)=VX2
PCH(3,KTMP)=VX3
C PCH(1)=TIME (2)=MM1 (3)=MM2
KTMP=KTMP+1
IF(IAMP.EQ.0)GO TO 2016
4003 VX1=0
IAMP=0
VX2=VX3
IF(J.EQ.ITMPO)GO TO 3019
PCH(1,KTMP)=0
PCH(2,KTMP)=VX2
PCH(3,KTMP)=VX2
C MM CAN BE FROM 11 UP ITMPO FACTOR FROM 10 DOWN.
C UP TO 30 ITMPO CHANGES MAY BE MADE.
1016 IA=I
IZ=1
3100 V(I-2)=CODE+DF
ISUB=3
5016 IF(IAMP.GE.0)GO TO 1299
117 IF(IZ-2)3013,9004,9004
103 K=INP(ML)
IF(K.EQ.ITT)GO TO 1106
IF(K.EQ.ISEMI)GO TO 1014
IF(K.NE.IBLA) GO TO 1899
ML=ML+1
GO TO 103
C@@@@@@@@ MAY 13,71 @@@@@@
C**********FEB 19,71
C ABOVE
3 IF(VX1.EQ.-99.)GO TO 4022
IF(CODE.EQ.-22.)GO TO 2017
C************ MAY 19,71
IF(CODE.LT.-23.OR.IZ/2*2.EQ.IZ)GO TO 17
C CHECKS PAIRS OF NUMBERS FOR 'RTAP'
2017 IF(VX1.EQ.10000.)GO TO 17
VX1=4./VX1
IF(JJ.NE.1)GO TO 2014
V(I)=VX1
GO TO 114
1217 IF(VX1.EQ.10000.)GO TO 114
C FOR "FINE" IN LIST
CC IF(CODE.EQ.-46.)GO TO 4217
CC IF(VX1.GT.VX2)V(I)=VX1+.999
CC IF(VX2.GT.VX1)VX2=VX2+.999
C ABOVE EXTENDS RANGE TO GIVE HIGHEST NOTE A CHANCE
CC4217 V(I+1)=VX2
V(I+1)=VX2
IF(CODE.EQ.-36.)CALL RANR(V,I)
2217 I=I+1
C SETS UP STRING OF RAND SELECTIONS
GO TO 114
3217 V(I)=V(I-2)
V(I+1)=RB
C FOR SLASH REPTS OF RAND SELEC UNITS. ("REP" CAN'T BE USED!)
GO TO 2217
C******** PUT IN ERROR TRAP FOR "REP" ETC. ******
2014 DO 9006 L=2,JJ
IF(VX(L).EQ.0)GO TO 17
9006 VX1=4./VX(L)+VX1
JJ=1
17 V(I)=VX1
IF(CODE.EQ.-46..OR.CODE.EQ.-36.)GO TO 1217
C JUMP IF STRING OF RAND SELECS.
IF(JJ.EQ.1)GO TO 114
L=VX(JJ)-1
X=V(I)
NL=I+1
I=L+I
DO 1017 K=NL,I
1017 V(K)=X
C ADDS UP TOTAL OF NOTES IN SEQ.
IZ=IZ+L
GO TO 114
1014 IF(CODE.EQ.-46..OR.CODE.EQ.-36.)GO TO 3217
V(I)=RB
C RB SAVES IT FOR SLASH REPEAT
114 RB=V(I)
I=I+1
IZ=IZ+1
GO TO 5016
4022 JC=VX2+.3
JD=VX3-.5
IF(JJ.EQ.2)JD=1
C********* MAY 19,71 ----MANY LINES ABOVE.
IZ=IZ+JC*JD
C JC=HOW MANY TIMES, JD=HOW MANY NOTES
DO 1005 K=1,JD
NL=I+JC-1
DO 2005 L=I,NL
2005 V(L)=V(L-JC)
1005 I=I+JC
RB=V(NL)
C RB SAVES DATA FOR SLASH REPEAT FEATURE.
GO TO 5016
9004 IF(ITMP.EQ.0)GO TO 3013
C*********** JUNE 1,71
IZ=IZ-1
C***** JAN. 1974
KA=1
IC=1
K=0
J=1
Z=0
RC=0
9007 Y=PCH(3,IC)/TP
X=PCH(2,IC)/TP
Z=PCH(1,IC)
YY=2.*Z/(Y+X)
224 IF(YY.NE.0)YY=2.*(Z-X*YY)/YY**2
XT(1)=X
XA=RA
RD=1
RB=0
ZZ=Z
7020 RA=V(IA+K)
IF(RA.EQ.10000.)GO TO 3013
4020 RD=1
IF(RA.LT.0)RD=-1.
RA=RA*RD
IF(KA.EQ.0)RA=RA-RC
W=RA
RB=W
IF(W.LE.Z)GO TO 2020
IF(Z.NE.0)GO TO 3020
RA=RA/Y
RB=-1.
RC=0
GO TO 8020
3020 W=Z
RC=W+RC
GO TO 24
2020 RC=0
24 IF(X.NE.Y)GO TO 424
RA=W/X
GO TO 8020
C DUR OF TMP + BG TIME OF TMP - NOTE VALUE -
C BG TIME OF NOTE. CHN=TBG.
424 RAX=XT(J)
RA=(-2.*RAX+(4.*RAX**2+8.*YY*W)**.5)/(2.*YY)
XT(J)=RAX+YY*RA
8020 IF(KA.EQ.0)RA=RA+XA
KA=1
IF(RC.NE.0)GO TO 1011
IF(T5.EQ.1)GO TO 8203
V(IA+K)=RA*RD
IF(K.EQ.IZ)GO TO 3013
C*********** JUNE 1,71
1011 IF(T5.EQ.1)GO TO 2011
K=K+1
IF(ZZ.NE.0)Z=Z-W
IF((Z.GT.0).OR.(RB.EQ.-1.))GO TO 7020
IC=IC+1
IF(RB.EQ.W)GO TO 9007
KA=0
K=K-1
GO TO 9007
C********* MAY 13,71 OMITS REPEATED RHY. FEATURE.
C ML=I-1
C ML=I-1
C*********** MAY 13,71 ********
3013 X=I-IJ
V(IJ+2)=X-3.
V(IJ)=X*ALL
IF(CODE.NE.-35)GO TO 4773
M=IJ+3
C SETS NUMBERS FOR FUNCS.
DO 313 K=M,I-1
313 IF(V(K).LT.85.)V(K)=V(K)+85.
GO TO 4773
2011 XA=RA
IF(K.GT.1)GO TO 9020
K=I-6
ZPAR=-9900.-CHN-ZZ
DO 3011 KL=8,I
IF((V(K).EQ.ZPAR).AND.(V(K+1).EQ.990000.))GO TO 9020
3011 K=K-1
9020 W=ZZ
IF(V(K+3))K=K+3
C ABOVE IS FOR TYPED IN TEMPO CHANGES
KA=K+3
ZZ=V(KA)
C DUR OF NEXT TEMPI
X=V(KA+1)
Y=V(KA+2)
213 KA=0
Z=ZZ
YY=2.*Z/(X+Y)
YY=2.*(Z-X*YY)/YY**2
CHN=CHN+W
XT(J)=X
IF(KA.EQ.1)Z=0
RA=PR
KA=0
K=K+3
GO TO 4020
2337 T=0
IF(ITYP)GO TO 23371
END FILE 21
DATA ENFI /25H(' INPUT ON FOR21.DAT'/) /
TYPE ENFI
C PUTS AWAY TYPED IN DATA. TO REUSE, EDIT FOR21.DAT.
23371 IF(SOS)WRITE(JOUT,902)
C WRITES A BLANK LINE
NWZZ=0
IAMP=0
IT3=0
K=1
IX=0
BG(NINS+1)=19999.
4011 IF(CNT(K))GO TO 5011
6011 IF(K.EQ.KZY)GO TO 4337
K=K+1
GO TO 4011
5011 L=V(I-1)/(-9900.)
IF(L.EQ.1)I=I-1
V(I)=CNT(K)
V(I+1)=P(K)
V(I+3)=-44.
I=I+5
IF(P(K).EQ.980000.)I=I-4
KL=I
REWIND 1
ICT=IPT(K,1)
CALL IFILE(1,ICT)
9011 L=I+6
READ(1,7011)(V(M),M=I,L)
C READS "CONDUCT" AND "RHYTHM" (TAP) DATA.
IF(V(L).EQ.999.)GO TO 8011
I=L+1
GO TO 9011
8011 IF(P(K).NE.980000.)GO TO 6337
DO 7337 K=L,I,-1
7337 IF(V(K).NE.999.)GO TO 8337
8337 I=K-1
V(I)=0
V(I+1)=V(K)
V(I+2)=V(K)
C K WAS I-1 ABOVE.
I=I+3
V(KL+1)=I-KL-1
C ABOVE RESETS WORDCOUNT FOR 'CONDUCT' DATA.
GO TO 4337
6337 DO 5337 M=I,L
KN=M
5337 IF(V(M).EQ.999.)GO TO 3337
3337 I=KN
KN=I-KL
V(KL-1)=KN
V(KL-3)=KN+3
GO TO 6011
7011 FORMAT(7F)
4337 IF(V(I-1).EQ.-9900.-BY)I=I-1
V(I)=-19899.
PP1=0
T6=10000.
DO 2118 K=1,NINS
ROFF(K)=0
C********* FEB 17,71
M=NP(K)
IT(K)=0
IPT(K,31)=0
NCNT(K,31)=1
DO 2118 L=1,M
NCNT(K,L)=1
2118 IPT(K,L)=0
DO 5013 K=1,IXIN
5013 X=RAND(0.0,0.0)
REWIND 1
IF(MX)CALL OFILE(1,ISLAC)
NW=1
NWX=0
TDUR=0
A=0
T2=1.
T4=1.
T5=0
J=1
MK=0
C IS THE ABOVE NEEDED?
IF(MX.NE.3)GO TO 40021
K=4
CC10023 N=V(K)/-11.
10023 N=AMOD(V(K),100.0)/-11.
C AMOD NEEDED BECAUSE CODE # MAY HAVE -100 FOR DF OR -200 FOR SUBR.
IF((N.NE.2.AND.N.NE.3.AND.N.NE.4).OR
1 .V(K-2).LT.10000.)GO TO 10021
J=V(K+1)
IF(J.EQ.1)GO TO 10024
IF(N.EQ.3.AND.V(K+J+1).EQ.101.)J=J-1
N=V(K-2)
L=N/10000
M=N-L*10000
TYPE 10022,INST(L),M,J
10024 K=K+ABS(V(K-1))
10021 K=K+1
IF(K.LT.I)GO TO 10023
40021 IF(MZ.NE.-4)GO TO 1002
N=1
40022 K=N+1
IF(N.GT.I)CALL EXIT
X=V(N)
IF(X.EQ.-199..OR.X.EQ.-99.)GO TO 40024
IF(X.GE.0)GO TO 40023
PRINT 4002,X
N=N+1
GO TO 40022
40024 J=N+1
GO TO 40025
C FOR 'SECTIONS'
40023 J=ABS(V(K))+K-1
40025 PRINT 4002,(V(K),K=N,J)
N=J+1
GO TO 40022
10022 FORMAT(1XA5,' P',I2,' HAS ',I3,' ITEMS.')
4002 FORMAT(10F12.3)
1002 IF(IDALL)GO TO 600
X=DUR(IDALL)
DO 2002 K=1,NINS
2002 IF(DUR(K))DUR(K)=X
C ***** SORTER *************************
C ******* OUTPUT LOOP FROM HERE ON ********
600 IL=0
C********** BELOW IS FOR 'SECTIONS'
KODE=0
NWX=NWX+1
MK=MK+1
Y=BNW(NW)
723 IL=IL+1
3723 Z=V(IL)
IF(Z.EQ.-19899.)GO TO 732
IF(Z.NE.-9900.-Y)GO TO 723
C********** BELOW IS FOR 'SECTIONS'
IF(V(IL-2).EQ.-199.)KODE=IV(IL-1)
2723 IL=IL+1
729 K=IL+2
MOT=V(IL+1)
RD=V(K)
IF(RD.EQ.-67.)GO TO 3726
RB=V(IL)
C************ DOWN TO 4150 IS FOR 'SECTIONS'
IF(RB.NE.-99.)GO TO 4150
KODE=IV(K-1)
2160 IF(KODE.EQ.0)GO TO 723
IF(MZ)WRITE(JOUT,9150),KODE
KL=Y/10000.
RB=Y+KL*10000.
DO 5150 KL=1,I
IF(V(KL).NE.-199..OR.IV(KL+1).NE.KODE)GO TO 5150
IV(K-1)=0
C WHEN 'PLAY' HAS BEEN FOUND, INDENTIFIER CHNGED TO 0
RD=V(KL+2)+9900.
DO 6150 L=KL+2,I
M=V(L)/(-9900.)
IF(M.NE.1)GO TO 6150
RA=RB+RD-V(L)-9900.
V(L)=-9900.-RA
C UPDATES BG TIMES INSIDE SECTION.
CALL BGSORT(RA)
C7150 IF(RA.EQ.BNW(KA))GO TO 6150
C UPDATES LIST OF CHANGE TIMES.
6150 IF(V(L).EQ.-299.)GO TO 160
5150 CONTINUE
160 IL=1
GO TO 3723
C*********** ABOVE IS FOR 'SECTION' REPEATS
4150 LK=RB/10000.+.2
IF(LK.GE.98)GO TO 7700
LP=RB-LK*10000
C LK=INST # LP=PARAM #
LN=IPT(LK,LP)
IPT(LK,LP)=IL+2
IF(RD.EQ.-66.)GO TO 726
IF(RD.EQ.-55..OR.RD.EQ.-56.)GO TO 1726
IF(RD.EQ.-23)GO TO 6700
2727 ML=IPT(LK,LP)
IF(MOT.GT.0)GO TO 3727
C USE NEG WDCNT FOR 'ALL'
DO 4727 KL=LK+1,NINS
IF(NP(KL).LT.LP.AND.LP.LT.31)NP(KL)=LP
IPT(KL,LP)=-(LK+(LP-1)*KZY)
NCNT(KL,LP)=10000
4727 IF(DUR(KL))DUR(KL)=1000.
C ASSUMES THAT DURATIONS ARE SET IN 'NOTES'.
C AFTER 'ALL' IS USED ONCE IT WORKS LIKE DUPL OR REP.
CC GO TO 2150
C ABOVE CHANGED TO BELOW DEC.6,72. 'ALL' WAS OMITTING 1ST ITEM.
GO TO 727
C 'MOVE' WITH 'ALL' KEEPS ORIGINAL TIME DATA REGARDLESS OF BG TIMES.
3727 IF(V(IL).NE.V(LN-1).OR.LN.EQ.0)GO TO 727
CC ************ JAN 20 ***********
DO 1727 L=1,NINS
DO 1727 KL=1,NP(L)
IF(LN.NE.IPT(L,KL))GO TO 1727
NCNT(L,KL)=10000
C ******* JAN 29,70
IPT(L,KL)=ML
C RESETS POINTERS FOR DUPL AND REP INSTS.
C *** 'ALL' WILL NOT WORK WITH RAN TF.!!!!!*******FEB 21,73
1727 CONTINUE
727 NCNT(LK,LP)=10000
C******** MAY 13,71 RHY REP. FEATURE OMITTED.
2150 IF(MOT)MOT=-MOT
IL=IL+MOT+1
3150 IF(V(IL))GO TO 3723
GO TO 729
726 RB=V(IL+3)
K=RB/10000.
L=RB-K*10000
IPT(LK,LP)=-(K+(L-1)*KZY)
GO TO 2727
3726 LK=V(IL)
M=V(K+1)
KL=NP(M)
DO 4726 L=1,KL
IPT(LK,L)=IPT(M,L)
IF(IPT(M,L).NE.0)NCNT(LK,L)=10000
C****** JUN 29 71 (LK,L) WAS (L,K)....???????
4726 CONTINUE
IPT(LK,31)=IPT(M,31)
K=0
GO TO 2150
C ABOVE IS FOR DUPLICATION ROUTINE NEXT ADJUSTS TIMES FOR 'RTAP'
6700 KL=IL+V(IL+1)+1.3
RC=V(K-2)
1770 IF(V(KL))GO TO 700
2700 KL=KL+V(KL+1)+1.3
GO TO 1770
700 KL=KL+1
IF(Z.NE.V(KL-1).OR.V(KL).NE.RC)GO TO 2700
KL=KL+3
KN=IL+3
LN=V(KN)+.3
DO 3700 L=1,LN,2
RA=V(L+KN)
KA=V(L+KN+1)+.3
RB=0
DO 4700 LP=1,KA
4700 RB=RB+V(KL+LP)
DO 5700 LP=1,KA
5700 V(KL+LP)=V(KL+LP)/RB*RA
V(KL+KA)=V(KL+KA)+.00030
3700 KL=KL+KA
GO TO 2150
C BELOW FOR 'TEMPO' SETUP
7700 T2=V(IL+4)
T1=V(IL+3)
TBG=Y
TDUR=V(IL+2)
AC=2.*TDUR/(T1+T2)
AC=2.*(TDUR-T1*AC)/AC**2
8700 IF(TDUR.EQ.0)TDUR=10000.
T5=1.
T6=TBG+TDUR
IT3=1.
IF(LK.EQ.98)IT3=IL+2
T4=1.
GO TO 2150
C*************** ANY WDCNTS DOWN FROM HERE. *********
C NEXT ADJUSTS 'MOVE' TIMES IF BG IS AT A NOTE NUMBER.
1726 IF(V(IL-1).GT.-19000.)GO TO 2727
RA=BT
K=IL-1
2726 V(K)=-9900.-RA
ISUB=-1
L=K+5
RB=V(L)+V(L-1)
V(L-1)=RA
K=K+V(K+2)+2
IF(V(K).GT.-19000..OR.V(K+1).NE.V(IL).OR.
1 V(K).NE.-9900.-RB)GO TO 2727
RA=RA+V(L)
CALL BGSORT(RA)
GO TO 2726
C CONVERTS BG TIME OF NOTE NUM TO REAL TIME. DOESN'T WORK WITH -66!
C NOW WE BEGIN ON!! NOTE NUM. NOT AFTER NOTE NUM.
732 DO 2606 K=NW,NWZ
2606 BNW(K)=BNW(K+1)
NWZ=NWZ-1
IF(NWZ.EQ.0)GO TO 2111
IF(NWZZ.EQ.1)GO TO 5111
NWZZ=1
IF(NWZ.EQ.1)GO TO 1111
DO 3111 K=1,NWZ
IF(BNW(K).LT.1000.)GO TO 3111
X=BNW(NWZZ)
BNW(NWZZ)=BNW(K)
BNW(K)=X
NWZZ=NWZZ+1
3111 CONTINUE
5111 IF(NWZZ.EQ.NWZ)GO TO 1111
L=NWZZ+1
X=BNW(NWZZ)
DO 4111 K=L,NWZ
IF(BNW(K).GT.X)GO TO 4111
RA=BNW(K)
BNW(K)=X
X=RA
4111 CONTINUE
BNW(NWZZ)=X
GO TO 1111
111 FORMAT(1XA5,'.DAT',12X,'EDIT FILE NAME=',A5,8X,
1'V ARRAY=',I4,'/2000 TEMPO FACTOR=',F6.2,4X,
1'RANDOM NUMBER =',I6/)
1023 FORMAT(/' < ',A5,'.DAT '/1XA5)
C********** BELOW IS FOR 'SECTIONS'
9150 FORMAT(/3X'******* SECTION ',A1)
2111 NWZ=-1
C ABOVE ORDERS BNW DATA TO SAVE TIME AT 1108 ON PG5.
1111 IF(MZ.EQ.0)GO TO 1601
IF(NWX.NE.1)GO TO 1486
WRITE(JOUT,111),ISLAC,IFLNM,I,TF,IXIN
C*********** JUNE 1,71
C********** BELOW IS FOR 'SECTIONS'
1486 IF(KODE.NE.0)WRITE(JOUT,9150),KODE
K=NWX-1
C*********** JUNE 1,71
IF(NWX.GT.1.AND.IT(J).NE.-3)WRITE(JOUT,3154),K,Y
IF(IT(J).EQ.-3)WRITE(JOUT,5154),K,BX,INST(J)
C*********** JUNE 1,71 X 3 K'S
DO 602 K=1,NINS
48 LK=INST(K)
C*********** JUNE 1,71
IF(NCNT(K,31).NE.10000.AND.NWX.GT.1)GO TO 602
CCNOV,72 IF(NCNT(K,31).NE.10000.AND.NWX.GT.1)GO TO 8826
NCNT(K,31)=1
IJ=IPT(K,31)
X=0
IF(IJ.NE.0)X=V(IJ+2)
WRITE(JOUT,5396),LK,X
X=DUR(K)
IF(X.GT.10000.)GO TO 83
WRITE(JOUT,8396),X
CCNOV,72 GO TO 8826
GO TO 602
5396 FORMAT(5XA5,' RANDOM TF =',F4.2,10X,'DURATION =',$)
7396 FORMAT('+',F5.0,' NOTES')
CCNOV,72
CC4396 FORMAT(5XA5,' % RANDOM RESTS DUR=',F7.3,'", FROM',
CC 1F6.3,' TO',F6.3)
CC485 FORMAT(5XA5,' % RANDOM RESTS = ',F4.2)
CCNOV,72
8396 FORMAT('+',F6.2,'"')
83 X=X-10000.
WRITE(JOUT,7396),X
CCNOV,72 *************************************************
CC8826 IF(NCNT(K,1).NE.10000)GO TO 602
CC NCNT(K,1)=1
CC IJ=IPT(K,1)+2
C********* FEB 19,71
CC IF(V(IJ)-5.)GO TO 7826
CC WRITE(JOUT,4396),LK,V(IJ-1),V(IJ),V(IJ+1)
C********* FEB 19,71
CC GO TO 602
CC7826 WRITE(JOUT,485),LK,V(IJ)
CCNOV,72 *************************************************
602 CONTINUE
715 IF(IT3.NE.1.)GO TO 1602
RA=T1*TP
RB=T2*TP
WRITE(JOUT,6154),RA,RB,TDUR
IT3=0
1602 IF(NWX.EQ.1)GO TO 315
IF(IT(J).EQ.-3)GO TO 1108
C*********** JUNE 1,71
6154 FORMAT(' TMP=',F7.3,' TO',F8.3,' DURING',F6.2,' SECS.'/)
7154 FORMAT(' ''CONDUCT'' FILE NAME = ',A5/)
5154 FORMAT(/' << CHANGE',I3,' BEGINS ON NOTE',F5.0,1XA5,' >>'/)
902 FORMAT(1XA5/)
3154 FORMAT(/' << BASIC TIME OF CHANGE',I3,' IS',F8.3,'" >>'/)
4154 FORMAT(' THE FIRST',F9.4,'" ARE OMITTED'/)
C*********** JUNE 1,71
IT(J)=IT(J)/10
GO TO 1108
315 IF(IT3.GT.1)WRITE(JOUT,7154),ICT
IF(OP1.NE.0)WRITE(JOUT,4154),OP1
1601 IF(NWX.GT.1) GO TO 1108
IF(MZ)WRITE(JOUT,1023),ISLAC,PLAY
IF(TF.GT.10.)TF=TF/60.
TF=1000./TF
DO 6015 K=1,30
6015 COPY(K)=-9900.
C INITS PARAM REPRESSION FEATURE.
IF(KB.EQ.0)GO TO 9926
ML=NINS+1
NL=NINS+KB
DO 9826 K=ML,NL
9826 BG(K)=OTH(K-NINS,1)
C 'OTH' INSERTS, WITH BG TIME IN SECONDS, CAN ONLY BE SET WITH TF=1
9926 DO 5015 K=1,NINS
IQ(K)=BG(K)*10000.
BG(K)=0
INP(K)=0
P1(K)=0
IF(DUR(K).LT.10000.)DUR(K)=DUR(K)-.0001
C******* FEB. 16,71 FOR ROUND-OFF NONSENSE
5015 CNT(K)=0
IF(MX)WRITE(1,1023)ISLAC,PLAY
BW=0
GO TO 500
752 FORMAT(1X15A5)
1108 M=0
JC=0
IF(NWZ)GO TO 1740
C NWZZ IS SET AT 3111 IN SORTR.
DO 740 K=1,NWZZ
X=BNW(K)
IF(X-.0001.GT.BT.OR.X.LE.BW.OR.BW)GO TO 2740
IT(J)=IT(J)*10
NW=K
GO TO 600
2740 IF(X.LT.1000..OR.X-J*10000.NE.CNT(J)+1.)GO TO 740
X=BT+PR
NW=K
BX=CNT(J)+1.
IT(J)=-3
GO TO 600
740 CONTINUE
IT(J)=0
1740 IF(J.LE.NINS)GO TO 31
7021 K=J-NINS
IF(JC.GT.0)K=JC
5740 IF(PP1.LT.OP1)GO TO 1752
IF(MZ)WRITE(JOUT,752),(OTH(K,L),L=2,16)
IF(MX)WRITE(1,752)(OTH(K,L),L=2,16)
C IF TF .NE.1, ALL INSERT TIMES MUST BE RESET
C IF FIRST PART OF NOTE LIST IS 'OMITTED', CHECK YOUR 'INSERTS'.
DO 17521 L=3,30
17521 COPY(L)=-9900.
C SO THAT ALL PARAMS WILL PRINT,AFTER AN INSERT.
1752 BG(K+NINS)=19999.
OTH(K,1)=19999.
IF(JC.GT.0)GO TO 21
31 KL=1
IF(KB.EQ.0)GO TO 2031
DO 1031 L=1,KB
K=L
X=OTH(K,1)-1000000.
M=X/100000.
IF(M.NE.J.OR.IQ(J).NE.0)GO TO 1031
C M=INST
IF(X-M*100000.EQ.CNT(J)+1)GO TO 5740
1031 CONTINUE
IF(J.GT.NINS)GO TO 500
2031 CNT(J)=CNT(J)+1
ICT=CNT(J)
C INSERT TRAP HERE FOR OVERLAP OF RESTARTED INSTS.******
NPA=NP(J)
PP1=P1(J)
IF(BT.GE.DUR(J))GO TO 5174
IF(IQ(J).EQ.0)GO TO 200
P2=-IQ(J)/10000.
IQ(J)=0
CNT(J)=-1
ICT=-1
GO TO 4203
C MK IS FLAG FOR RESTS
200 MK=0
IF((BT.EQ.0.AND.J.EQ.1).OR.IPT(J,1).EQ.0)GO TO 203
KN=IPT(J,1)-1
IF(KN.GT.0)GO TO 12033
12032 KN=JPT(-KN)
IF(KN)GO TO 12032
KN=KN-1
C FOR 'ALL' IN P32. FOLLOWS UP ON POINTERS TO POINTERS!
C SOMEDAY PUT P1(32) IN WITH OTHER PARAMS BELOW!!!!
12033 IJ=V(KN)
IF(ABS(V(KN)).EQ.4.)GO TO 1203
C 'IABS' IS FOR -4 USED WITH 'ALL'
Z=(BT+9900.+V(KN-2))/V(KN+2)
C******* FEB 19,71
IF(Z.GT.1.)Z=1.
Y=V(KN+3)
X=(V(KN+4)-Y)*Z+Y
C******* FEB 19,71
CC****** TAKEN OUT NOV 9,72 ??? IF(X.EQ.0)IPT(J,1)=0
GO TO 204
1203 X=V(KN+3)
204 Y=RAND(0.0,1.0)
IF(Y-X)MK=-1
203 DF=1.
C DF=DUTY FACTOR
DO 2155 L=2,NPA
ISUB=0
C WHY DOES ISUB APPEAR AT 14700/5?
IDF=0
C IDF IS DUTY FACTOR FLAG
IJ=IPT(J,L)
12031 IF(IJ)IJ=JPT(-IJ)
IF(IJ)GO TO 12031
C FOLLOWS UP ON POINTERS TO POINTERS!
PM=1.
IF(IJ.GT.1)GO TO 2157
P(L)=0
CC GO TO 21552
GO TO 21551
C 7/73
2157 LN=IJ+2
NM=ABS(V(IJ-1))+LN-4
NL=V(IJ)
IF(NL.GT.-200)GO TO 372
ISUB=-1
NL=NL+200
C FOR SUBROUTINE FLAG
372 IF(NL.GT.-100)GO TO 272
IDF=-1
NL=NL+100
C DEC.6,72 FINDS DUTY FACTOR PARAM
272 VIJ2=V(IJ+1)
KN=NL/(-11)
IF(KN.EQ.0)GO TO 1100
GO TO (61,62,62,62,65,65,67,68),KN
1100 IF(VIJ2.EQ.1.)GO TO 1200
ML=3
1900 KA=1
VX1=0
DO 1156 K=LN,NM,ML
VX(KA+1)=V(K)+VX(KA)
1156 KA=KA+1
X=RAND(0.0,1.)
DO 1157 K=2,11
IF(X.GT.VX(K))GO TO 1157
KL=K-1
IF(KN.EQ.7)GO TO 6157
GO TO 1400
1157 CONTINUE
1400 LN=IJ+3*KL
1462 RA=V(LN)
IF(RA.EQ.10000.)GO TO 5174
C FOR "FINE" IN RLIST
RB=V(LN+1)
PAR=RAND(RA,RB)
1300 IF(NL.NE.-1)PM=2.
C IF 2 THEN PRINTS A5
GO TO 1155
1200 PAR=V(IJ+2)
GO TO 1300
C NEXT IS FOR SUBROUTINE AND QUAD CALLS
61 IF(NL.LT.-12)GO TO 6100
601 X=P2
CC IF(NL.EQ.-11)PL(L)=2.
C '.5' MAKES ALL SUBR PARAMS PRINTOUT.
CALL SUBR
C******MAY 25,71
CC IF(P(L).EQ.10000.)GO TO 5174
IF(DF)GO TO 5174
C DF=-1 IN 'SUBR' WILL CAUSE 'END' FOR INST.
CC PM=PL(L)
IF(L.EQ.2)GO TO 4203
IF(X.EQ.P2)GO TO 21552
PP2=P2
PR=P2
GO TO 21552
C ABOVE IS FOR P2 CHANGES IN SUBROUTINE
C TF,TEMPO,CONDUCT WILL AFFECT P2 ONLY WHEN P2 CALLS THE SUBR.,
C ALL 'TEMPO' CHANGES WILL BE IGNORED!! (THEN DUR. IN SECS. MUST
C BE SET TO 'REAL TIME'.)
C NEXT IS FOR QUAD ROUTINES
6100 CALL QUAD(NL)
GO TO 21552
C FOLLOWING IS FOR STRINGS OF VALUES.
62 KL=NCNT(J,L)+1
IF(KL.GT.VIJ2)KL=1
IF(NL.NE.-46.AND.NL.NE.-36)GO TO 162
C THIS PART FOR STRINGS OF RAND SELECTION
LN=KL+IJ+1
KL=KL+1
IF(KL.GT.VIJ2)KL=1
NL=NL+45
C FOR NUMBERS ONLY SO FAR(THIS MAKES NL=-1. FOR NOTES, =9)
162 NCNT(J,L)=KL
IF(NL.GT.-22)GO TO 1462
C JUMP RAND SELECTION
PAR=V(IJ+KL+1)
C********** MAY 13,71 RHY REPEAT FEATURE OMITTED.
C************************
CC DEC.6,72 IF(NL.EQ.-45)DF=PAR
IF(KN.NE.3)GO TO 1155
C*******JULY 16,71 IF(PAR.EQ.101.)GO TO 5174
IF(PAR.EQ.10000.)GO TO 5174
PM=2.
IF(PAR.GT.100..OR.PAR.LT.1.)PM=3.
IF(PAR.EQ.85.)MK=-1
GO TO 5155
65 W=-9900.-V(IJ-3)
C W=BG TIME OF MOVE.
X=ABS(V(IJ-1))
IF(NL.EQ.-56.OR.NL.EQ.-58)PM=2.
Z=(BT-W)/VIJ2
C Z= % OF WAY THROUGH.
IF(Z.GT.1.)Z=1.
Y=V(LN)
W=V(IJ+3)
IF(X.EQ.7.)W=V(IJ+4)
IF(NL.LT.-58)GO TO 16002
PAR=(W-Y)*Z+Y
IF(X.EQ.7.)GO TO 1600
GO TO 1155
C************** JUNE 1,71
CC16002 PAR=(W-Y+1.)**Z-1.+Y
C FOR "MOVX"
CC IF(W-Y)PAR=(Y-W+1.)**(1.-Z)-1.+W
C******** FEB/73
16002 IF(W.EQ.0)W=W+.01
IF(Y.EQ.0)Y=Y+.01
PAR=Y*((W/Y)**Z)
C THE .01 IS NEEDED FOR MOVE TO OR FROM 0.
IF(X.NE.7.)GO TO 1155
W=V(IJ+5)
Y=V(IJ+3)
CC X=(W-Y+1.)**Z-1.+Y
CC IF(W-Y)X=(Y-W+1.)**(1.-Z)-1.+W
IF(W.EQ.0)W=.01
IF(Y.EQ.0)Y=.01
X=Y*((W/Y)**Z)
GO TO 16003
C NEXT IS FOR MOVING RAND RANGES.
C1600 PAR=(V(IJ+4)-Y)*Z+Y
1600 W=V(IJ+3)
C*********** BACK TO 65 IS NEW. FEB. 15,71
X=(V(IJ+5)-W)*Z+W
C************ JUNE 1,71
16003 PAR=RAND(PAR,X)
GO TO 1155
67 LN=IJ+3
NM=LN+VIJ2-1
ML=1
GO TO 1900
4155 K=(PAR-9999.0)*100.+.1
P(L)=P(K)
PM=PL(K)
GO TO 21551
C ANY # OVER 9999. REPEATS ANOTHER PARAM.(9999.21 REPEATS P21)
6157 LN=V(LN-1)
DO 1068 K=1,KL
1068 IF(K.LT.KL)LN=LN+V(LN)+1
2068 PM=LN+1
PAR=LN+V(LN)
GO TO 5155
68 KL=NCNT(J,L)
IF(KL.EQ.0.OR.KL.EQ.10000)KL=VIJ2
PM=KL+1
PAR=PM+V(KL)-1
KL=PAR+1
IF(V(KL).EQ.10000.)DUR(J)=BT
C 'END' OR 'FINE' IN 'LIT' LIST.
IF(V(KL).EQ.999.)KL=IJ+2
NCNT(J,L)=KL
GO TO 5155
C ******* JAN 20 *************
1155 IF(PAR.EQ.10000.)GO TO 5174
C TYPE 'END' AS LAST IN ANY STRING TO SET DURATION.
IF((PAR.GT.9999.).AND.(PM.EQ.1.))GO TO 4155
C****JULY 16,71 1155 IF((PAR.GT.9999.).AND.(PM.EQ.1.))GO TO 4155
5155 P(L)=PAR
21551 PL(L)=PM
IF(ISUB)GO TO 601
IF(L.EQ.2)GO TO 4203
21552 IF(IDF.GE.0)GO TO 2155
DF=PAR
IDF=0
2155 CONTINUE
9203 IF(KB.EQ.0)GO TO 1170
NL=KB
DO 2203 K=1,KB
X=OTH(NL,1)
IF(X.LT.100000.)GO TO 2203
L=X/100000.
Y=(X-L*100000.)/100.
IX=Y
JC=NL
IF(J.EQ.L.AND.IX.EQ.ICT)GO TO 5203
2203 NL=NL-1
GO TO 1170
4203 PR=P2
IF(T5.EQ.0)GO TO 7203
IF(IT3.LE.1.OR.BT.LT.TBG+TDUR)GO TO 6203
3155 IT3=IT3+3
TBG=TBG+TDUR
TDUR=V(IT3)
IF(BT.GE.TBG+TDUR)GO TO 3155
T1=V(IT3+1)
T2=V(IT3+2)
X=2.*TDUR/(T1+T2)
AC=2.*(TDUR-T1*X)/X**2
6203 RA=PR
IF(BT.EQ.TBG)XT(J)=T1
K=IT3
RC=0
RD=1
KA=1
RB=0
Z=TDUR+TBG-BT
X=T1
Y=T2
YY=AC
CHN=TBG
ZZ=TDUR
GO TO 4020
8203 P2=RA*RD
7203 P2=P2*T4
X=P2*TF
C P2 IS KEPT WITHOUT TF*
K=X+.5
IF(X)K=X-.5
72031 ROFF(J)=ROFF(J)+K-X
IF(ABS(ROFF(J)).LT.1.)GO TO 7155
Y=1.
IF(ROFF(J))Y=-1.
K=K-Y
ROFF(J)=ROFF(J)-Y
C ROUND-OFF GAP WILL NOT EXCEED .001
C*********** FEB 17,71
7155 PP2=K/1000.
C AVOIDS ROUND-OFF PROBLEMS
IF(IPT(J,31).EQ.0)GO TO 6155
IF(ICT)GO TO 1170
X=V(IPT(J,31)+2)/2.
Y=RAND(-X,X)
IF(PP2.GE.0)GO TO 615
MK=-1
PP2=-PP2
615 PP2=PP2-RDEV(J)+Y
RDEV(J)=Y
C TOTAL RAND DEV. WON'T EXCEED P31
C SET P31 TO .0001 TO BRING VOICE BACK TO EXACT TIME(0 WON'T DO IT)
K=PP2*1000.+.5
C****** CHECK THIS OUT 1/10/72 :::::::
61551 PP2=K/1000.
C NEVER MORE THAN .1( DEVIATION WITH RAN TF. (RTF=.05)
6155 IF(ICT)GO TO 9203
GO TO 2155
5203 JD=Y*100-IX*100+.5
IF(JD.GT.0)GO TO 3203
M=0
P1(J)=PP1+PP2
GO TO 7021
3203 P(JD)=OTH(JC,2)
X=OTH(JC,3)
IF(X.NE.1.)X=3.
C 'EDITS' PRINT,NUM. OR 5 CHARS.
PL(JD)=X
C NEXT ADDED NOV.72 CHECK FOR SIDE AFFECTS !!!!! **********
IF(JD.EQ.2)PP2=P2
C 'TF' AND 'TEMPO' WILL NOT AFFECT PP2 'EDITS'.
1170 IF(MK.OR.PP2)GO TO 2022
ZPAR=PP1
P1(J)=PP1+PP2
C ZPAR IS USED HERE WHEN OP1(OMIT) IS .GT.0. OMIT IS IN REAL TIME.
LK=INST(J)
2021 IF(PP1.LT.OP1)GO TO 2612
IF(INVIS(J).LT.0)GO TO 2170
C ALL PARAMS WILL PRINT,1ST TIME WHEN USING 'OMIT'.
IF(INONLY.GT.0)GO TO 1204
C*********** MAY 16,71 ↑↑↑
6021 IF(P(NPA).NE.COPY(NPA).OR.PL(NPA).GT.1)GO TO 5021
C******* MAY 25,71
C 'LIT' DATA WILL ALWAYS PRINT.
NPA=NPA-1
IF(NPA.GT.2)GO TO 6021
5021 DO 1304 K=3,NPA
1304 COPY(K)=P(K)
1204 IF(PL4.NE.1.)GO TO 2170
P4=P4*AMPFAC
L=0
INP(J)=P4
DO 1021 K=1,NINS
1021 IF(P1(K).GT.PP1)L=L+INP(K)
IF(L-IAMP-1)GO TO 2170
IAMP=L
AMPTIM=PP1
2170 IF(MX.EQ.3)GO TO 2612
C ********* MAY 17,71
PP1=PP1-OP1
C PUTS SPACES BETWEEN NOTES .GT. .05( APART
IF((MZ.NE.-1).OR.(A.GE.PP1))GO TO 5170
IF(INONLY)WRITE(JOUT,902)
A=PP1+.05
5170 ML=10
IF(NPA.LT.10)ML=NPA
MLX=3
NL=2
IF(INVIS(J).EQ.0)GO TO 3170
CC5170 IF(INVIS(J).EQ.0)GO TO 3170
CC MLX=3
LK=0
C NEEDED TO INIT INVISIBLE MODE PRINT-OUT (NO INST NAME, P1, P2)
C NEXT CREATES FORMAT DATA IN IFM ARRAY.
31701 KL=3
GO TO 4170
3170 IF(.NOT.INONLY.AND.J.NE.INONLY)GO TO 2612
VX(1)=PP1
VX2=PP2*DF
IFM3='F9.3,'
IFM4=IFM3
KL=5
CC ML=10
CC IF(NPA.LT.10)ML=NPA
CC MLX=3
CC NL=2
IF(NPA.LT.3)GO TO 2121
4170 NL=2
DO 1121 K=MLX,ML
X=P(K)
L=PL(K)
IF(L-2)321,521,621
321 IF(X.GE.0)GO TO 4211
IFM(KL)=IFCOM
NL=NL+1
KL=KL+1
4211 IFM(KL)='F9.3,'
C CREATES 'F9.3'
421 VX(KL-NL)=X
GO TO 1121
521 IFM(KL)=IFM2
C CREATES '1XA5'
LN=X
VX(KL-NL)=SCAL(LN)
GO TO 42
621 IF(L.GT.3)GO TO 721
VX(KL-NL)=X
C ABOVE LETS A5 WD BE USED IN SUBR BY SETTING PL(N)=3.
42 IFM(KL)=IFM2
GO TO 1121
721 LN=X
IFM(KL)=I1X
NL=NL+1
DO 821 M=1,LN-L+1
KL=KL+1
IOUT(KL-NL)=IV(L-1+M)
821 IFM(KL)=IA1
1121 KL=KL+1
C NO MORE THAN 80 ITEMS IN FORMAT.
2121 IF(KL.LE.80)GO TO 21211
21212 FORMAT(' ERROR! TOO MANY LIT. ITEMS')
TYPE 21212
21211 DO 921 M=KL+1,80
921 IFM(M)=IBLA
IFM(KL)=')'
L=KL-NL-1
IF(MX)WRITE(1,IFM)LK,(VX(K),K=1,L)
IF(.NOT.MZ)GO TO 30210
IF(ML.GE.NPA)IFM(KL)='$)'
WRITE(JOUT,IFM),LK,(VX(K),K=1,L)
30210 IF(ML.GE.NPA)GO TO 3021
MLX=ML+1
ML=ML+10
IF(ML.GT.NPA)ML=NPA
LK=IBLA
GO TO 31701
3021 IF(MX)WRITE(1,3616)INST(J),ICT
30211 IF(MZ)WRITE(JOUT,8902),J,INST(J),ICT,BT
2612 PP1=ZPAR
GO TO 21
8902 FORMAT('+;<'I2,1XA5,I4,' >',F7.3)
3616 FORMAT(';PRINT(P1);< ',A5,I4)
C PRINTS RESTS
2022 PP2=ABS(PP2)
C IN THIS VERSION TYPE 'R' FOR RESTS IN ANY PARAM BUT P2.
C FOR RESTS IN SEQS. TYPE -DUR.
C WHEN RANDOM RESTS ARE CHOSEN, SEQS. MISS NOTES.
C RAN RESTS ARE NOT TOUCHED BY SUBROUTINES!!!
INP(J)=0
P1(J)=PP1+PP2
C STORES NEXT P1 TIME FOR THIS INST.
IF((MZ.NE.-1).OR.(PP1.LT.OP1))GO TO 21
X=PP1-OP1
IF(A.GE.X)GO TO 121
WRITE(JOUT,902)
A=X+.05
121 IF(INONLY.OR.J.EQ.INONLY)WRITE(JOUT,1110),INST(J),X,PP2,
1 J,INST(J),ICT
21 PR=ABS(PR)
BG(J)=BT+PR
IF(ICT.EQ.DUR(J)-10000.)GO TO 5174
IF(BG(J).LT.DUR(J))GO TO 500
5174 BG(J)=19999.
DO 3174 K=1,NINS
C INSERTS CANT FOLLOW LAST REGULAR NOTE.
C (ADD REST IF INSERT AT END IS NEEDED.)
3174 IF(BG(K).LT.19999.)GO TO 500
GO TO 175
C CHOOSES INST WITH NEXT BEGIN TIME.
500 J=1
BW=BT
NL=NINS+KB
DO 22 K=2,NL
22 IF(BG(J).GT.BG(K))J=K
IF(J.GT.NINS.OR.NINS.EQ.1)GO TO 3022
J=1
DO 5022 K=2,NINS
X=P1(J)
Y=P1(K)+.0001
C LOWEST NUMBERED INST WILL COME 1ST IF BG TIMES ARE VERY CLOSE
IF(BG(J).EQ.19999.)X=19999.
IF(BG(K).EQ.19999.)Y=19999.
5022 IF(X.GT.Y)J=K
C ABOVE IS FOR ROUND-OFF PROBLEMS WITH 'TEMPO' AND 'CONDUCT'.
3022 BT=BG(J)
IF((BT.EQ.19999.).OR.(P1(J).GE.DURX))GO TO 175
IF(CNT(J).GT.0)GO TO 1022
IF(CNT(J).EQ.0)P1(J)=0
IF(CNT(J).EQ.-1)CNT(J)=0
C N.B. 'TF' CONTROLS BG TIME WHEN BG .GT. 0
1022 IF((BT.LT.T6).OR.(IT3.GT.1))GO TO 1108
T4=T2
T5=0
T6=10000.
GO TO 1108
1175 FORMAT('+',A5,'=',F7.3,2X,$)
1109 FORMAT(' FINISH; < ',A5,'.DAT')
1110 FORMAT(' <',A5,2F9.3,2X,'******* REST <'I2,1XA5,I4)
1603 FORMAT(' AMPL. FACTOR=',F4.2,', MAX.AMP.=',I4,', AT TIME',
1 F8.3)
175 IF(MZ)WRITE(JOUT,1109),ISLAC
CC IF(MX.GE.0)GO TO 603
IF(MX.GE.0)GO TO 4175
WRITE(1,1109),ISLAC
END FILE 1
603 FORMAT(' TOTAL DURS: ',$)
CC IF(MZ)GO TO 4175
CC TYPE 1603,AMPFAC,IAMP,AMPTIM
CC TYPE 603
CC GO TO 5175
4175 WRITE(JOUT,1603),AMPFAC,IAMP,AMPTIM
WRITE(JOUT,603)
5175 DO 2175 K=1,NINS
X=P1(K)-OP1
IF(MZ)GO TO 6175
TYPE 1175,INST(K),X
GO TO 2175
6175 WRITE(JOUT,1175),INST(K),X
2175 CONTINUE
IF(JOUT.NE.22)GO TO 3175
END FILE 22
CALL PRINT
REWIND 22
K='FOR22'
CALL OFILE(22,K)
C LEAVES FOR22.DAT WITH 0K
END FILE 22
3175 TYPE 1023,ISLAC
END